home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir35
/
chkfl141.zip
/
CHKFILE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-11-13
|
7KB
|
313 lines
{ CheckFile v1.41 -- (c)1993 J Scott Hedspeth }
Program ChkFile;
{$M 3000,0,0}
Uses DOS,CRT;
Var
F, G : Text;
FileName : String[12];
DirInfo : SearchRec;
FileOK,
FileNO,
FileTotal,
N : Integer;
Choice : Char;
Reply,
FileLine,
NewFile : String;
Mon, Yr,
Dy : String[2];
AddFile : File of Byte;
Size : Longint;
Year,
Month,
Day,
DayofWeek: Word;
Const
Ver = '-={ CheckFile v1.41 -- (c)1993 J Scott Hedspeth }=-';
InFile = 'FILES.LST';
TempFile = 'FILES.)O(';
Procedure ShowMenu; Forward;
Procedure ShowHelp; Forward;
Procedure ShowVer;
Begin
ClrScr;
Writeln;
Writeln(' ',Ver);
Writeln;
End;
Procedure ErrorMessage(Which : Byte);
Begin;
TextColor(Yellow);
ShowVer;
TextColor(Red);
Case Which Of
1 : Writeln(' Could not find FILES.LST!');
2 : Writeln(' Could not read FILES.LST!');
End;
TextColor(LightGray);
Writeln(^G);
Halt(1);
End;
Procedure CheckFiles;
Label
NextLine,LastLine;
Begin
ClrScr;
ShowVer;
Writeln(' Reading FILES.LST...');
Writeln;
FileOK := 0;
FileNO := 0;
N := 6;
Assign(F,InFile);
{$I-}ReSet(F);{$I+};
If IOResult <> 0 Then ErrorMessage(2);
Repeat
NextLine:
Readln(F,FileName);
If FileName = ' ' Then
Begin
If Not EOF(F) Then Goto NextLine;
If EOF(F) Then Goto LastLine;
End;
FindFirst(FileName,AnyFile,DirInfo);
If DOSError = 0 Then
Begin
GotoXY(1,N);
Write(' ',FileName,' OK');
Inc(FileOK);
End;
If DOSError <> 0 Then
Begin
GotoXY(1,N);
Write(' ',FileName,' NOT FOUND! <enter>');
Readln(Reply);
Inc(FileNO);
Inc(N);
End;
LastLine:
Until EOF(F);
Writeln;
Close(F);
Writeln;
Writeln(' Done!');
Writeln;
FileTotal := FileOK + FileNO;
Writeln(' FILES.LST contains ',FileTotal,' files,');
Writeln;
Writeln(' --> ',FileOK,' file(s) located');
Writeln(' --> ',FileNO,' file(s) missing');
Writeln;
Write(' <enter>');
Readln(Reply);
End;
Procedure ClearList;
Label
NextLine;
Begin
ClrScr;
ShowVer;
Writeln(' Reading FILES.LST...');
Assign(F,InFile);
Assign(G,TempFile);
ReSet(F);
ReWrite(G);
Repeat
NextLine:
Readln(F,FileLine);
If Copy(FileLine,35,12) = 'Uploaded By:' Then Goto NextLine;
Writeln(G,FileLine);
Until EOF(F);
Close(F);
Close(G);
Erase(F);
Writeln(' Writing FILES.$$$...');
Writeln(' Erasing FILES.LST...');
Rename(G,InFile);
Writeln(' Copying FILES.$$$ ==> FILES.LST...');
Writeln;
Writeln(' Done!');
Writeln;
Write(' <enter>');
Readln(Reply);
End;
Procedure AddFiles;
Label
NextFile, NextLine, NoMore;
Begin
NextFile:
GetDate(Year,Month,Day,DayOfWeek);
Year := Year - 1900;
If Year > 99 Then
Year := Year - 100;
Str(Year:2, Yr);
Str(Month:2, Mon);
Str(Day:2, Dy);
If Yr[1] = ' ' Then Yr[1] := '0';
If Mon[1] = ' ' Then Mon[1] := '0';
If Dy[1] = ' ' Then Dy[1] := '0';
ClrScr;
ShowVer;
Writeln(' Enter blank line to quit.');
Writeln;
Write(' Enter filename to add: ');
Readln(NewFile);
For n := 1 to Length(NewFile) Do
NewFile[n] := UpCase(NewFile[n]);
If Length(NewFile) < 3 Then ShowMenu;
FindFirst(NewFile, AnyFile, DirInfo);
If DOSError <> 0 Then
Begin
Writeln;
Writeln(^G,' ',NewFile,' not found!');
Writeln;
Write(' <enter>');
Readln(Reply);
GoTo NextFile;
End;
Assign(AddFile,NewFile);
ReSet(AddFile);
Size := FileSize(AddFile);
Assign(G,InFile);
Append(G);
Write(G,NewFile);
For N := 1 to (16 - Length(NewFile)) Do
Write(G,' ');
Write(G,Size:6);
Write(G,' ');
Write(G,Mon,'-',Dy,'-',Yr);
Write(G,' ');
Writeln;
Writeln(' Enter a description for: ',NewFile);
Writeln(' |--------+---------+---------+---------|');
N := 10;
GotoXY(2,N);
Readln(FileLine);
If Length(FileLine) < 5 Then
Begin
Writeln(G,'No description given');
Goto NoMore;
End;
Writeln(G,FileLine);
NextLine:
GotoXY(2,N+1);
Inc(N);
Readln(FileLine);
If Length(FileLine) < 5 Then Goto NoMore;
Writeln(G,' ',FileLine);
Goto NextLine;
NoMore:
Close(G);
Close(AddFile);
Writeln;
Writeln(' ',NewFile,' added to FILES.LST');
Writeln;
Write(' <enter>');
Readln(Reply);
GoTo NextFile;
End;
Procedure ViewFiles;
Begin
ClrScr;
Assign(F,InFile);
ReSet(F);
N := 1;
Repeat;
Readln(F,FileLine);
Writeln(' ',FileLine);
Inc(N);
If N >= 25 Then
Begin
Write(' <S>top, <enter> to continue: ');
Readln(Reply);
If (Reply = 's') or (Reply = 'S') Then ShowMenu;
N := 1;
End;
Until EOF(F);
Close(F);
Write(' <enter>');
Readln(Reply);
End;
Procedure ShowExit;
Begin
TextBackground(Black);
TextColor(LightGray);
ShowVer;
Halt(0);
End;
Procedure ShowMenu;
Begin
ClrScr;
Writeln;
Writeln(' ',Ver);
Writeln;
Writeln(' [A]dd file(s) [I]nfo about CheckFile');
Writeln(' [L]ist FILES.LST [Q]uit to DOS');
Writeln(' [R]emove "Uploaded by:"');
Writeln(' [V]erify FILES.LST');
Writeln;
Write(' Command: ');
Choice := ReadKey;
Choice := UpCase(Choice);
Case Choice of
'A' : AddFiles;
'I' : ShowHelp;
'L' : ViewFiles;
'R' : ClearList;
'V' : CheckFiles;
'Q' : ShowExit;
End;
ShowMenu;
End;
Procedure ShowHelp;
Begin
ClrScr;
ShowVer;
Writeln;
Writeln(' * CheckFile was written for use with TriBBS v4.0+.');
Writeln;
Writeln(' * CHKFILE.EXE must be in the current directory or your path statement.');
Writeln;
Writeln(' * CheckFile can: Verify the existence of files in FILES.LST');
Writeln(' Remove the "Uploaded by:" line from FILES.LST');
Writeln(' Add files to the current FILES.LST');
Writeln(' View the current FILES.LST');
Writeln;
Writeln(' CheckFile is offered as FreeWare. The author assumes no responsibility');
Writeln(' for anything, for any reason. Use this program at your own risk.');
Writeln;
Writeln(' You may contact the author via:');
Writeln;
Writeln(' US Mail Rt 4 Box 227 Mocksville, NC 27028');
Writeln(' WB4YZA BBS 704-284-4854 300 - 14,400 bps v.32bis');
Writeln(' CompuServe 71042,3277');
Writeln;
Writeln;
Writeln;
Write(' <enter>');
Readln(Reply);
End;
Begin
FindFirst(InFile,AnyFile,DirInfo);
IF DOSError <> 0 Then ErrorMessage(1);
TextBackground(Blue);
TextColor(Yellow);
If ParamStr(1) = '/?' Then ShowHelp;
ShowMenu;
End.